COMMON/STF/RSTFAC(0/7),RSTJ2 /POSI/STFF(0/7),JJ2,JPQ
	1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
	1 RCLEF(0/7) /RSIG/RSIG(0/7) /IVV/NRD(200)
	COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
	COMMON/XRN/RN(3500) /SF/KL,RT,KP,STFSZ,NAMX,EXT
	1 /PTR/KWDS(350)/LLL/LLL,LL,I,IX,XSIG/XXX/LK,LP,JY /JN/J,N
C  INCREASE DIMENSION OF KWDS (KPN & Q) FOR VERY FULL PAGES.
      DIMENSION MM(1500),NN(1500),BARS(509),STFNM(0/7),KSAVE(30),
	1 RMETER(0/7),RCL(0/7),NUMS(30),PGTRN(500),SAVES(470),U(1)
C KSAVE AND SAVES ARE TO SAVE REHEARSAL NUMS, ETC. -- LIMIT=30
	COMMON /PX/KPN(450) /Q/Q(4000) /KBAR/KBAR(1027) /IRST/IRST
 	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
	1 /RSP/KNM(100) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT,LASTNM
	1 /JWDS/JWDS(300),RRN(3000)
C  JWDS IS EQUIVALENCED IN PTMOVX.F4 AND RESTP.F4
	DATA FIB/.7/,RSPC/25./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.0/
	1 ,RLTRSZ/1.0/,SPCPG/2.7/
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
	1,(MM,RN),(NN,RN(1501)),(KS,RS),(BARS,KBAR(4)),(JRSTF,RSTJ2)
	1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
	1,(STFNM,KBAR(508)),(NUM1,NUMS,KPN),(PGTRN(1),KBAR(5 16))
	1,(SAVES,Q(3001)),(KSAVE,Q(3475)),(U,KBAR(1026))
C  HANDLES 503 PAGES AND PAGE-TURN INFO. IN KBAR AND PGTRN
C  RQ(2) IS R4, RQ(3) IS R5 ETC.  STAFF NAMES START AT KBAR(508)=STF(0)

	RN(2)=0
	EXT='MS'
	IRST=0
C IRST IS USED IN SUBROUTINE RESTP
	IPG=0
	KBR=0
	NMPG='PAGEA'
	JPG=0
	JRD=1
	ENDLN=0
	SAVSIZ=0
	ISN=0
	NCNT=10000
	IFOUND=0

	TYPE 1000   
	ACCEPT 2000,NAMX
	IF(NAMX.EQ.0)CALL PT2
	IF(NAMX.EQ.3)CALL TRONLY
	NPG=NAMX-2
	TYPE 3300
	IF(NPG.GE.0)GO TO 3000
	ACCEPT 2,KS,NTYPE
C  TYPE -1 AFTER NAME(I.E.5 SPACES) TO PRINT INST. NAMES AS READ.
	JNM=1

	CALL LO2UP(KS)
143	CALL IFILE(1,KS)
	READ(1,2)K
	IF(K.NE.'COMME')GO TO 543
743	READ(1,643),K,K,K
C  READ ET DIRECTORY !∃∀ βλπα∀πεβα!ββX!
	IF(K.NE.';')GO TO 743
	READ(1,2)K
	GO TO 843
C  FIRST LINE MUST BE EXTENSION NAME
643	FORMAT(3A1)
2	FORMAT(A5,30I)
3300	FORMAT(' TYPE FILE NAME -- '$)
1000	FORMAT(' 1=PARTS, 2=PAGE LAYOUT, 3=TRNSP ONLY, <CR>=OLD  '$)
2000	FORMAT(I)
543	CALL IFILE(1,KS)
843	CALL READX(1,KNM(JNM),EXT,KEND,NUMS)
	IF(KEND)GO TO 343
	JNM=JNM+1
	DO 434 K=1,30
	J=KPN(K)
	JPG=JPG+1
	NRD(JPG)=J
C  BE CAREFUL ABOUT RUNNING OVER NRD ARRAY (100)-- ZEROS ARE INSERTED***********
434	IF(J.EQ.0)GO TO 843
	GO TO 843
3000	CALL READX(5,NAMX,EXT,KEND,NUMS)
	KNM(1)=NAMX
	END

	SUBROUTINE READX(IDEV,NAME,IEXT,KEND,NUMS)
	DIMENSION NUMS(1),RI(30)
	COMMON /PTR/INP(72) /JWDS/JWDS(1)
	EQUIVALENCE(INP,RI)
100	FORMAT(A5,73A1)
	KEND=0
C IDEV=DEVICE NUMBER (1=DSK, 5=TTY)
	READ(IDEV,100,END=12)NAME,K,INP
	IF(K.EQ.' ')GO TO 2 
	IF(K.NE.'.')GO TO 8
C NOW FOUND EXTENSION.  GO PACK IT.
	DO 4 K=2,5
4	NUMS(K)=' '
	DO 5 K=1,5          
	IF(INP(K).EQ.' ')GO TO 6         
5	NUMS(K)=INP(K)
6	CALL PACKX(IEXT,NUMS)
	CALL LO2UP(IEXT)
	GO TO 11
2	K=1
11	CALL ASCNUM(INP(K),RI,JWDS,M)
C ASCNUM CHANGES ASCII TO NUMBERS, JWDS IS A DUMMY FOR NOW, M=HOW MANY
	DO 7 K=1,M
7	NUMS(K)=RI(K)
10	CALL LO2UP(NAME)
	RETURN
8	TYPE 9
9	FORMAT(' **** USE ONLY 5-LETTER NAMES.  ONLY 1 EXT. CAN BE USED')
	STOP
12	KEND=-1
	END

	SUBROUTINE PACKX(NAM,KNM)
	DIMENSION KNM(5)
	DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
	1 , MM/"774000000000/
	NAM=0
	DO 12 K=5,1,-1
	NAM=NAM .OR. (KNM(K) .AND. MM)
	IF (K.EQ.1)RETURN
17	IF (NAM.GE.0)GO TO 13
	NAM = (( NAM .AND. LL)/KK) .OR. JJ
	GO TO 12
13	NAM = NAM / KK
12	CONTINUE
	END

	SUBROUTINE ASCNUM(I,RI,KNT,M)
      DIMENSION KNT(72),RI(72),I(72)
      INTEGER ZERO,NINE,KNT,J,I,DOT,BLA
CC      INTEGER*1 ZERO,NINE,KNT,J,I,DOT,BLA
      DATA DOT/'.'/,BLA/' '/,ZERO/'0'/,NINE/'9'/
      DO 10 K=1,72
10    KNT(K)=-1
      IDEC=0
      M=1
      C=1.0
      R=0
      DO 5 K=1,72
      J=I(K)
      IF(J.EQ.BLA)GO TO 8
      IF(J.NE.DOT)GO TO 6
      IDEC=-1
      GO TO 5
6     IF(J.GE.ZERO.AND.J.LE.NINE)GO TO 7
      CALL STOW(J,RI(M))
      KNT(M)=0
      GO TO 9
7     IF(IDEC.NE.0)C=C*0.1
      CALL CONV(R,J)
      GO TO 5
8     IF(R.EQ.0)GO TO 5
      A=R*C
      RI(M)=A
      KNT(M)=1
      R=0
      C=1.0
	IDEC=0
9     M=M+1
5       CONTINUE
      M=M-1
        END
 
      SUBROUTINE CONV(R,J)
CC      INTEGER*1 J
CC      R=R*10.+J-48
	L=(J-'0')/536870912
	R=R*10.+L
      END
 
      SUBROUTINE STOW(R,RI)
      RI=R
      END
 
      SUBROUTINE ASC(R)
200   FORMAT(' ',A1)
      WRITE(5,200)R
      END
      SUBROUTINE RNUM(R)
201   FORMAT(F13.4)
      WRITE(5,201)R
      END

	SUBROUTINE LO2UP(J)
C CONVERTS ALL LOWER CASE TO UPPER CASE.
	J=J.AND..NOT.((J/2).AND."201004020100)
	END

	FUNCTION TSIG(Q,J)
	DIMENSION Q(1)
	TSIG=IFIX(Q(J+5)*100.0+Q(J+6)+.5)
C COMBINES METER NUMS.  (2/4 = 204. ETC.)
	END